1 KBS 8145번 여론조사

여론조사결과 등록현황 상세보기 KBS가 조사의뢰하고 (주)한국리서치가 조사기관우로 참여한 정기(정례)조사,대통령선거,정당지지도 (전국 정기(정례)조사 대통령선거 정당지지도 정치, 사회현안 등 ) 사례를 들어 데이터 추출방법을 살펴보자.

1.1 페이지 메타 데이터

XML 페이지 이미지 메타파일에 포함된 XML 정보를 추후 작업이 가능한 형태로 데이터를 전처리 작업한다.

library(tidyverse)
library(xml2)

kbs_meta <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.xml")

kbs_meta %>% 
  xml_attrs("title")
named character(0)
kbs_meta_nodes <- xml_find_all(kbs_meta, "//page")

kbs_meta_attributes <- kbs_meta_nodes[[1]] %>% xml_attrs(.) %>% names()

kbs_meta_df <- xml_attrs(kbs_meta_nodes) %>% 
  list2DF() %>% 
  janitor::clean_names() 

row.names(kbs_meta_df)  <- kbs_meta_attributes

kbs_meta_tbl <- kbs_meta_df %>% 
  rownames_to_column(var = "attributes") %>% 
  pivot_longer(cols = -attributes)  %>% 
  pivot_wider(names_from = attributes, values_from = value) %>% 
  select(-name)

kbs_meta_tbl %>% 
  reactable::reactable()

1.2 여론조사결과

여론조사 결과 본문을 페이지 단위로 추출하자.

 
kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")

## KBS 여론조사 페이지 ------
kbs_survey_page <- kbs_survey %>% 
  xml_children()

xml_length(kbs_survey_page) %>% length
[1] 23
## 특정 페이지 : 응답자 분포표 값 --------------
xml_siblings(kbs_survey_page)[[3]] %>% 
  xml_children() %>% 
  xml_contents() %>% 
  as.character()
 [1] "1"                                           
 [2] "응답자  분포표 (1)"                          
 [3] " Base= 전체"                                 
 [4] " 조사완료 목표할당"                          
 [5] " 가중  값  배율"                             
 [6] "(B/A)"                                       
 [7] "사례수 (명 )"                                
 [8] "(A)"                                         
 [9] " 비율(%)"                                    
[10] " 사례수 (명 )"                               
[11] "(B)"                                         
[12] " 비율(%)"                                    
[13] "▣  전체  ▣ (1,000) 100.0 (1,000) 100.0 1.0"
[14] "성별"                                        
[15] " 　"                                         
[16] "남자 (507) 50.7 (497) 49.7 1.0"              
[17] "여자 (493) 49.3 (503) 50.3 1.0"              
[18] "연령 　"                                     
[19] "18-29 세 (174) 17.4 (176) 17.6 1.0"          
[20] "30-39 세 (152) 15.2 (152) 15.2 1.0"          
[21] "40-49 세 (182) 18.2 (187) 18.7 1.0"          
[22] "50-59 세 (198) 19.8 (193) 19.3 1.0"          
[23] "60-69 세 (165) 16.5 (162) 16.2 1.0"          
[24] "70세이상 (129) 12.9 (130) 13.0 1.0"          
[25] "거주지역 　"                                 
[26] "서울 (188) 18.8 (189) 18.9 1.0"              
[27] "인천 /경기 (313) 31.3 (313) 31.3 1.0"        
[28] "대전 /세종 /충청 (108) 10.8 (107) 10.7 1.0"  
[29] "광주 /전라 (99) 9.9 (98) 9.8 1.0"            
[30] "대구 /경북 (99) 9.9 (99) 9.9 1.0"            
[31] "부산 /울산 /경남 (150) 15 (150) 15.0 1.0"    
[32] "강원 /제주 (43) 4.3 (44) 4.4 1.0"            
## 특정 페이지 : 응답자 분포표 좌표 --------------
table_h <- xml_siblings(kbs_survey_page)[[3]] %>% 
  xml_children() %>% 
  xml_attr("h")

table_w <- xml_siblings(kbs_survey_page)[[3]] %>% 
  xml_children() %>% 
  xml_attr("w")

table_l <- xml_siblings(kbs_survey_page)[[3]] %>% 
  xml_children() %>% 
  xml_attr("w")

2 KBS 8145번 페이지 이미지

2.1 여론조사 이미지 다운로드

<https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/1.png> 같은 형식이라 KBS 8145 여론조사 결과를 이미지로 받아 낼 수가 있다. 이를 위해서 glue::glue() 함수로 다운로드할 URI 주소를 특정하고 download.file() 함수를 사용해서 로컬 디렉토리에 저장한다.

for(page in 1:23) {
  page_url <- glue::glue("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/{page}.png")
  print(page_url)
  download.file(url = page_url, destfile = glue::glue("data/nesdc/kbs/kbs_{page}.png"), mode = 'wb')
}

다운로드 결과는 fs::dir_ls() 함수를 사용해서 확인이 가능하다.

fs::dir_ls("data/nesdc/kbs/")
data/nesdc/kbs/kbs_1.png  data/nesdc/kbs/kbs_10.png data/nesdc/kbs/kbs_11.png 
data/nesdc/kbs/kbs_12.png data/nesdc/kbs/kbs_13.png data/nesdc/kbs/kbs_14.png 
data/nesdc/kbs/kbs_15.png data/nesdc/kbs/kbs_16.png data/nesdc/kbs/kbs_17.png 
data/nesdc/kbs/kbs_18.png data/nesdc/kbs/kbs_19.png data/nesdc/kbs/kbs_2.png  
data/nesdc/kbs/kbs_20.png data/nesdc/kbs/kbs_21.png data/nesdc/kbs/kbs_22.png 
data/nesdc/kbs/kbs_23.png data/nesdc/kbs/kbs_3.png  data/nesdc/kbs/kbs_4.png  
data/nesdc/kbs/kbs_5.png  data/nesdc/kbs/kbs_6.png  data/nesdc/kbs/kbs_7.png  
data/nesdc/kbs/kbs_8.png  data/nesdc/kbs/kbs_9.png

다운로드 받은 여론조사결과를 일별할 수 있도록 쭉 살펴보자.

library(tidyverse)
library(slickR)

kbs_pages <- fs::dir_ls("data/nesdc/kbs/")

kbs_tbl <- tibble(file_path = kbs_pages)

slickR(kbs_tbl$file_path, height = 600)

2.2 XML 파일 파싱

특정 페이지에서 좌표값과 함께 해당 영역의 텍스트를 추출하는 로직을 구현해보자.

library(xml2)
library(reactable)

kbs_survey <- read_xml("https://www.nesdc.go.kr/files/result/202109/FILE_202109180931525561.pdf.files/FILE_202109180931525561.pdf.text.xml")

## KBS 여론조사 페이지 ------
kbs_survey_page <- kbs_survey %>% 
  xml_children()

## 특정 페이지 : 목차 --------------
xml_siblings(kbs_survey_page)[[2]] %>% 
  xml_children() %>% 
  xml_contents() %>% 
  as.character()
 [1] " [ 목차 ]"                                                                                            
 [2] "응답자 분포표(1)  ............................................................................  1"    
 [3] "응답자 분포표(2)  ............................................................................  2"    
 [4] "[표 1] 국정운영 평가 ........................................................................  3"     
 [5] "[표 2] 대선 후보 적합도 .....................................................................  4"     
 [6] "[표 3] 대선 후보 지지  강도  ..................................................................  5"   
 [7] "[표 4] 지지  후보가 정당  대선 후보가 안될  경우  지지  후보 .....................................  6"
 [8] "[표 5] 더불어민주당  대선 후보 적합도 ........................................................  7"    
 [9] "[표 6] 국민의힘  대선 후보 적합도 ............................................................  8"    
[10] "[표 7] 대선 후보 가상  대결 (이재명  vs 윤석열 ) ................................................  9" 
[11] "[표 8] 대선 후보 가상  대결 (이낙연  vs 윤석열 ) ................................................10"  
[12] "[표 9] 대선 후보 가상  대결 (이재명  vs 홍준표 ) ...............................................  11" 
[13] "[표 10] 대선 후보 가상  대결 (이낙연  vs 홍준표 ) ..............................................  12" 
[14] "[표 11-1]  대선 후보 호감도  - 윤석열  ........................................................  13"  
[15] "[표 11-2]  대선 후보 호감도  - 이낙연  ........................................................  14"  
[16] "[표 11-3]  대선 후보 호감도  - 이재명  ........................................................  15"  
[17] "[표 11-4]  대선 후보 호감도  - 홍준표  ........................................................  16"  
[18] "[표 12] 정당지지도  .........................................................................  17"    
[19] "[표 13] 대선 인식 (정권연장  vs 정권교체 ) ....................................................  18"  
[20] "[표 14] 고발  사주  의혹  관련  인식  ...........................................................  19"
[21] "[표 15] 고발  사주  의혹  영향  ................................................................  20" 
## 특정 페이지 : 응답자 분포표 좌표 --------------
kbs_xml_tbl <- 
tibble(t = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("t"),      # t = top
       l = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("l"),      # l = left
       h = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("h"),      # h = height
       w = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("w"),      # w = width
       p = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_attr("p"),      # p = paragraph(?)
       content = xml_siblings(kbs_survey_page)[[2]] %>% xml_children() %>% xml_contents() %>%  as.character()) %>% 
  mutate( t = as.numeric(t),
          l = as.numeric(l),
          h = as.numeric(h),
          w = as.numeric(w))

kbs_xml_tbl %>% 
  select(-p) %>% 
  reactable::reactable(
    columns = list(
      t = colDef(width = 80),
      l = colDef(width = 80),
      h = colDef(width = 80),
      w = colDef(width = 80)
    )
  )

2.3 페이지 이미지 겹쳐 확인

뭔가 좌표가 직관적이 아니라 이를 해결할 수 있는 방법을 찾아보자.

library(magick)

kbs_xml_img <- image_read('data/nesdc/kbs/kbs_3.png')

kbs_xml_img_box <- image_draw(kbs_xml_img)

rect(xleft   = kbs_xml_tbl$l[2], 
     ytop    = kbs_xml_tbl$t[2], 
     xright  = kbs_xml_tbl$l[2] + kbs_xml_tbl$w[2]/10,
     ybottom = kbs_xml_tbl$t[2] + abs(kbs_xml_tbl$h[2]),
     border = "red", lty = "solid", lwd = 3)

dev.off()
png 
  2
 

데이터 과학자 이광춘 저작

kwangchun.lee.7@gmail.com